home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 60.zip / BS1 part 60 / Kick Pascal v2.10 d2.adf / DEMO / 3D.backup < prev    next >
Text File  |  1990-11-04  |  17KB  |  418 lines
  1. PROGRAM _3D;
  2.  
  3. { geschrieben von:      Michael Janich 1989      }
  4. { bearbeitet von:       Jens "Himpelsoft" Gelhar }
  5. { ALL RIGHTS REVERSED.                           }
  6.  
  7. { Programm wird mit ESC beendet.                           }
  8. { Mit den Cursortasten kann man die Rotationsrichtung des  }
  9. { Objekts ändern, mit einigen Tasten des Ziffernblocks     }
  10. { den Standpunkt des Betrachters.                          }
  11. { In der vorliegenden Version gibt es noch Fehler, wenn    }
  12. { Linien den Bildschirmrand überschreiten.                 }
  13.  
  14. CONST width=640;
  15.       height=256; { Screen }
  16.  
  17.       file_name = 'KP-DEMOS:Demo/3D_coords/coords.haus';
  18.       { Aus dieser Datei werden die Koordinaten gelesen }
  19.  
  20.       rot_angle=0.12; { rotation in one step }
  21.  
  22.  
  23. {$incl "Intuition.lib","Graphics.lib" }
  24.  
  25.  
  26. TYPE Point = REAL;
  27.      Ptr2Point_3d = ^Point_3d;
  28.      Point_3d = RECORD x, y, z: Point;
  29.                 END; { Rec Point_3d }
  30.      Ptr2Point_2d = ^Point_2d;
  31.      Point_2d = RECORD x, y: Point;
  32.                 END; { Rec Point_2d }
  33.      Ptr2Coords = ^Coords;
  34.      Coords = RECORD c: Point_3d;
  35.          next: Ptr2Coords;
  36.      END;
  37.  
  38. VAR  fin: BOOLEAN;
  39.      FP: Point_3d;
  40.      chain: Ptr2Coords;
  41.      W1,W2:^Window;
  42.      Rast1:^RastPort;
  43.      MyScreen1: ^Screen;
  44.      Rast2:^RastPort;
  45.      Rast: ^RastPort;
  46.      MyScreen2: ^Screen;
  47.      t1: IntuiText;
  48.      sin_rot_angle, cos_rot_angle: REAL;
  49.      act_pos: STRING[99];
  50.      Pointer: ^Byte; { Requiered for key-codes }
  51.      LastKey: Byte;
  52.      i: INTEGER;
  53.      pro_Res,last: Point_2d; { Result of projetion-function }
  54.      rot_res: Point_3d; { Result of rotation-func }
  55.      rot,scr_no: INTEGER;
  56.  
  57. (************************************************************************)
  58. (* Function:                                                            *)
  59. (*                                                                      *)
  60. (* Open Library and Screen                                              *)
  61. (************************************************************************)
  62.  
  63. PROCEDURE Init;
  64. VAR i: INTEGER;
  65.  
  66.    BEGIN { Init }
  67.       fin := FALSE;
  68.       Pointer := Ptr($bfec01);
  69.       LastKey := 0;
  70.       OpenLib(IntBase,'intuition.library',0);
  71.       OpenLib(GfxBase,'graphics.library' ,0);
  72.       MyScreen1:=Open_Screen(0, 0, width, height, 1, 0, 1, HIRES or GENLOCK_VIDEO,'3d-Haus');
  73.       MyScreen2:=Open_Screen(0, 0, width, height, 1, 0, 1, HIRES or GENLOCK_VIDEO,'3d-Haus');
  74.       W1:=Open_Window(0,0,width,height,1,0,$0800,Nil,MyScreen1,width,height,width,height);
  75.       W2:=Open_Window(0,0,width,height,1,0,$0800,Nil,MyScreen2,width,height,width,height);
  76.       Rast1:=W1^.RPort;
  77.       Rast2:=W2^.RPort;
  78.       Rast := Rast1;
  79.       SetRGB4(^MyScreen1^.ViewPort,0,1,1,1); { almost black }
  80.       SetRGB4(^MyScreen2^.ViewPort,0,1,1,1);
  81.       SetRGB4(^MyScreen1^.ViewPort,1,14,14,14); { almost withe }
  82.       SetRGB4(^MyScreen2^.ViewPort,1,14,14,14);
  83.       FP.x := -40; { Point of eye }
  84.       FP.y := -40;
  85.       FP.z := -40;
  86.       sin_rot_angle := sin(rot_angle);
  87.       cos_rot_angle := cos(rot_angle);
  88.       last.x := width div 2; { else undefinded }
  89.       last.y := height div 2;
  90.       scr_no := 1; { screen_number toggles between 1 and 2 }
  91.       rot := 2;    { rotation axis 1,2,3 }
  92.    END; { Proc Init }
  93.  
  94. (************************************************************************)
  95. (* Input:                                                               *)
  96. (*                                                                      *)
  97. (* 3d-Point; call by reference                                          *)
  98. (************************************************************************)
  99. (* Output:                                                              *)
  100. (*                                                                      *)
  101. (* 3d-Point                                                             *)
  102. (************************************************************************)
  103. (* Function:                                                            *)
  104. (*                                                                      *)
  105. (* rotate point by the rot_angle                                        *)
  106. (************************************************************************)
  107.  
  108. PROCEDURE Rotate_alfa (VAR a: Point_3d); { We change the original point }
  109. BEGIN
  110.    a.y := a.y * cos_rot_angle - a.z * sin_rot_angle;
  111.    a.z := a.y * sin_rot_angle + a.z * cos_rot_angle;
  112. END; { Proc Rotate_alfa }
  113.  
  114. PROCEDURE Rotate_beta (VAR a: Point_3d); { We change the original point }
  115. BEGIN
  116.    a.x := a.x * cos_rot_angle + a.z * sin_rot_angle;
  117.    a.z := a.z * cos_rot_angle - a.x * sin_rot_angle ;
  118. END; { Proc Rotate_beta }
  119.  
  120. PROCEDURE Rotate_gamma (VAR a: Point_3d); { We change the original point }
  121. BEGIN
  122.    a.x := a.x * cos_rot_angle - a.y * sin_rot_angle;
  123.    a.y := a.x * sin_rot_angle + a.y * cos_rot_angle;
  124. END; { Proc Rotate_gamma }
  125.  
  126. { please verify the +- in r_gamma }
  127.  
  128. (************************************************************************)
  129. (* Input:                                                               *)
  130. (*                                                                      *)
  131. (* 3d-Point                                                             *)
  132. (************************************************************************)
  133. (* Output:                                                              *)
  134. (*                                                                      *)
  135. (* 2d-Point                                                             *)
  136. (************************************************************************)
  137. (* Function:                                                            *)
  138. (*                                                                      *)
  139. (* Convert py central-perspectiv                                        *)
  140. (************************************************************************)
  141.  
  142. PROCEDURE Projection (a: Point_3d); { result in global Pro_res }
  143. VAR t: Point;
  144.  
  145.    BEGIN { Func Projection }
  146.       {$if def debug}
  147.          WriteLn("Projection: Eingabe: (",a.x,",",a.y,",",a.z,").");
  148.       {$endif debug}
  149.       IF abs(a.y - FP.y) <1e-3
  150.          THEN t := 0
  151.          ELSE t := a.y / (2*(a.y - FP.y));
  152.       pro_res.x := 2*(a.x - t*(a.x - FP.x))+width/2;
  153.       pro_res.y :=   (a.z - t*(a.z - FP.z))+height/2;
  154.       {$if def debug}
  155.          WriteLn("----------- Ausgabe: (",pro_res.x,",",pro_res.y,").");
  156.       {$endif debug}
  157.  END; { Func Projection }
  158.  
  159. (************************************************************************)
  160. (* Input:                                                               *)
  161. (*                                                                      *)
  162. (* 2d-Points                                                            *)
  163. (************************************************************************)
  164. (* Function:                                                            *)
  165. (*                                                                      *)
  166. (* Check Point for screen-dimens. cut, if neccessary                    *)
  167. (************************************************************************)
  168.  
  169. PROCEDURE Check (VAR a: Point_2d);
  170. VAR temp: Point_2d;
  171.  
  172. BEGIN
  173.    temp := a;
  174.    IF a.x < 0 THEN { right of screen }
  175.       IF (last.x-a.x)=0 THEN a.x := -1 ELSE BEGIN { check for division by 0 }
  176.          a.y := last.y - (last.y-a.y)*last.x/(last.x-a.x); a.x := 0;
  177.       END;
  178.    IF a.y >= height THEN
  179.       IF (last.y-a.y)=0 THEN a.x := -1 ELSE BEGIN
  180.          a.x := a.x - (a.x-last.x)*(last.y-height)/(a.y-last.y); a.y := height-1;
  181.       END;
  182.    IF a.x >= width THEN BEGIN
  183.       {$if def debug}
  184.          WriteLn("a.x ist zu gross: ",a.x," >= ",width);
  185.       {$endif}
  186.       IF (a.x-last.x)=0 THEN a.x := -1 ELSE BEGIN
  187.          a.y := last.y - (last.y-a.y)*(last.x-width)/(a.x-last.x); { an dieser Stelle gabs immer den /0-error }
  188.          a.x := width-1;
  189.       END;
  190.    END;
  191.    IF a.y < 0 THEN
  192.       IF (last.y-a.y)=0 THEN a.x := -1 ELSE BEGIN
  193.          a.x := a.x - (a.x-last.x)*last.y/(last.y-a.y); a.y :=  0;
  194.       END; { letztes ist noch zu überprüfen }
  195.    {$if def debug}
  196.       IF(a.x <> temp.x) OR (a.y <> temp.y) THEN
  197.          WriteLn("Changes in Check-Procedure.");
  198.    {$endif debug}
  199.    last := temp;
  200.  
  201. END; { Proc Check }
  202. (************************************************************************)
  203. (* Input:                                                               *)
  204. (*                                                                      *)
  205. (* Two 2d-Points (from-Coord, to-Coord)                                 *)
  206. (************************************************************************)
  207. (* Function:                                                            *)
  208. (*                                                                      *)
  209. (* Draw Line on Screen                                                  *)
  210. (************************************************************************)
  211.  
  212. PROCEDURE Draw_line(a: Point_2d);
  213.    BEGIN
  214.       Check (a);
  215.       {$if def debug}
  216.           WriteLn("Linie nach (",a.x,",",a.y,").");
  217.       {$endif}
  218.       IF a.x <> -1 THEN Draw (Rast, round(a.x), round(a.y));
  219.    END; { Proc Draw }
  220.  
  221. (************************************************************************)
  222. (* Input:                                                               *)
  223. (*                                                                      *)
  224. (* 2d-Point (to-Coord)                                                  *)
  225. (************************************************************************)
  226. (* Function:                                                            *)
  227. (*                                                                      *)
  228. (* Move Grafik-Cursor                                                   *)
  229. (************************************************************************)
  230.  
  231. PROCEDURE Move_Line(a: Point_2d);
  232.    BEGIN
  233.       Check (a);
  234.         {$if def debug}
  235.            WriteLn("Bewegen nach (",a.x,",",a.y,").");
  236.         {$endif}
  237.       IF a.x <> -1 THEN Move(Rast, round(a.x), round(a.y));
  238.    END; { Proc Move_line }
  239.  
  240. (************************************************************************)
  241. (* Input:                                                               *)
  242. (*                                                                      *)
  243. (* Keyboard                                                             *)
  244. (************************************************************************)
  245. (* Function:                                                            *)
  246. (*                                                                      *)
  247. (* change point of eye                                                  *)
  248. (************************************************************************)
  249.  
  250. PROCEDURE Read_Change;
  251.    BEGIN
  252.      LastKey := Pointer^;
  253.      CASE LastKey OF
  254.        133: FP.x := FP.x + 1;
  255.        197: FP.x := FP.x - 1;
  256.        131: FP.y := FP.y + 1;
  257.        195: FP.y := FP.y - 1;
  258.        129: FP.z := FP.z + 1;
  259.        193: FP.z := FP.z - 1;
  260.        103: rot := 1;
  261.        101: rot := 1;
  262.        097: rot := 2;
  263.        099: rot := 2;
  264.        139: rot := 3;
  265.        201: rot := 3;
  266.        127, 117, 119: fin := TRUE;
  267.        Otherwise
  268.      END; { CASE }
  269.  
  270.      CASE scr_no OF
  271.       1: BEGIN Rast:=Rast2; ScreenToFront(MyScreen1) END;
  272.       2: BEGIN Rast:=Rast1; ScreenToFront(MyScreen2) END
  273.      END;
  274.  
  275.      scr_no := 3-scr_no;
  276.      SetAPen(Rast,0);
  277.      RectFill(Rast,0,0,Width-1,Height-1);
  278.      SetAPen(Rast,1);
  279.    END; { Proc Read_Changes }
  280.  
  281. (************************************************************************)
  282. (* Input:                                                               *)
  283. (*                                                                      *)
  284. (* Chain of 3d-points                                                   *)
  285. (************************************************************************)
  286. (* Function:                                                            *)
  287. (*                                                                      *)
  288. (* Calculate and Draw 3d-points                                         *)
  289. (************************************************************************)
  290.  
  291. PROCEDURE Calc_Draw (root: Ptr2Coords);
  292.  
  293.    BEGIN
  294.       WHILE root <> NIL DO
  295.       BEGIN
  296.         IF root^.c.x = -1 THEN
  297.            BEGIN
  298.               root := root^.next;
  299.               CASE rot OF
  300.                  1: Rotate_alfa (root^.c);
  301.                  2: Rotate_beta (root^.c);
  302.                  3: Rotate_gamma(root^.c);
  303.               ELSE; END; { case }
  304.               Projection (root^.c);
  305.               Move_Line(pro_res);
  306.            END
  307.            ELSE BEGIN
  308.               CASE rot OF
  309.                  1: Rotate_alfa (root^.c);
  310.                  2: Rotate_beta (root^.c);
  311.                  3: Rotate_gamma(root^.c);
  312.               ELSE; END; { case }
  313.               Projection(root^.c);
  314.               Draw_Line(pro_res);
  315.            END;
  316.         root := root^.next;
  317.      END; { WHILE }
  318.    END; { Proc Calc_Draw }
  319.  
  320. (************************************************************************)
  321. (* Input:                                                               *)
  322. (*                                                                      *)
  323. (* File of coords of object                                             *)
  324. (************************************************************************)
  325. (* Output:                                                              *)
  326. (*                                                                      *)
  327. (* Root of chain                                                        *)
  328. (************************************************************************)
  329. (* Function:                                                            *)
  330. (*                                                                      *)
  331. (* read  file  from extern device                                       *)
  332. (************************************************************************)
  333.  
  334. FUNCTION Read_Coords: Ptr2Coords;
  335. VAR  f: FILE OF CHAR;
  336.      old_coord, result, temp: Ptr2Coords;
  337.  
  338.    BEGIN
  339.       New (result);
  340.       WITH result^.c DO
  341.       BEGIN
  342.          x := -1;
  343.          y := 0;
  344.          z := 0;
  345.       END; { WITH }
  346.       old_coord := result;
  347.       Reset (f, file_Name);
  348.       IF EoF(f) THEN Error ("File not Found.");
  349.       WHILE NOT EoF(f) DO
  350.       BEGIN
  351.          New (temp);
  352.          WITH temp^.c DO
  353.          BEGIN
  354.             ReadLn (f, x, y, z);
  355.             {$if def debug}
  356.                WriteLn("Gelesene Coordinaten: (",x,",",y,",",z,").");
  357.             {$endif}
  358.          END; { WITH }
  359.          old_coord^.next := temp;
  360.          old_coord := temp;
  361.       END; { WHILE }
  362.       temp^.next := NIL; { End of chain }
  363.       Read_Coords := result;
  364.    END; { Func Read_Coords }
  365.  
  366.  
  367. (************************************************************************)
  368. (* Function:                                                            *)
  369. (*                                                                      *)
  370. (* Close libraries and screen                                           *)
  371. (************************************************************************)
  372.  
  373.  
  374. PROCEDURE Close_(list:Ptr2Coords);
  375. VAR temp: Ptr2Coords;
  376.    BEGIN
  377.       WHILE (list <> NIL) DO
  378.       BEGIN
  379.          temp := list^.next;
  380.          dispose (list);
  381.          list := temp;
  382.       END; { WHILE }
  383.       Close_Screen(MyScreen1);
  384.       Close_Screen(MyScreen2);
  385.       CloseLib(intbase);
  386.       CloseLib(GfxBase);
  387.    END;
  388.  
  389.  
  390. (************************************************************************)
  391. (* Input:                                                               *)
  392. (*                                                                      *)
  393. (*                                                                      *)
  394. (************************************************************************)
  395. (* Output:                                                              *)
  396. (*                                                                      *)
  397. (*                                                                      *)
  398. (************************************************************************)
  399. (* Function:                                                            *)
  400. (*                                                                      *)
  401. (*                                                                      *)
  402. (************************************************************************)
  403.  
  404. BEGIN { Main }
  405.    Init;
  406.    chain := Read_Coords;
  407.    REPEAT
  408.       Calc_Draw (chain);
  409.       Read_Change;
  410.       act_pos := '('+RealStr(FP.x,0)+','+RealStr(FP.y,0)+','+RealStr(Fp.z,0)+')';
  411.       t1:=IntuiText(1,0,1,0,0,Nil,act_pos,Nil);
  412.       PrintIText (Rast1, ^t1, 10,190);
  413.       PrintIText (Rast2, ^t1, 10,190);
  414.    UNTIL fin;
  415.    Close_(chain);
  416. END.
  417.  
  418.